;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
;:::::   Reza Lisp Program, Farsi Text Program -    Ver. 1.00  for AutoCAD 14  or later::::::::
;:::::   Reza Darvishi ,  September 2001 Ahwaz , IRAN  +99(0611) 3778677 ::::::::
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
(defun rtd (d) (setq d (/ (* d 180.0) pi)))
(defun c:nd()
 (command "_.style" "naskhd" "naskhd" 0 1 0 "Y" "N")
 (alert "Naskhd.shx loaded..")
)
(defun c:nn()
 (command "_.style" "naskhn" "naskhn" 0 1 0 "Y" "N")
 (alert "Naskhn.shx loaded..")
)
(defun c:ns()
 (command "_.style" "naskhs" "naskhs" 0 1 0 "Y" "N")
 (alert "Naskhs.shx loaded..")
)
(defun c:kf()
 (command "_.style" "kofi" "kofi" 0 1 0 "Y" "N")
 (alert "kofy.shx loaded..")
)
(defun c:tf()
 (command "_.style" "trafic-b" "trafic-b" 0 1 0 "Y" "N")
 (alert "trafic-b.shx loaded..")
)
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 (setq asci_m1 (list 104 151 152 153 78 110 169 170 171 66 98 133 134 135 67 99 136 137 138 70 92 124 211 212 213 44 226 227 228 60 229 230 231 62 232 233 234 235 236 237 32 71 72 86 118 193 194 195 167 168))
 (setq asci_m2 (list 32 33 35 36 37 38 40 41 42 43 45 46 47 48 49 50 51 52 53 54 55 56 57 61 63 64 94 127 128 129))
 (setq asci_m (append asci_m1 asci_m2))
 (setq asci_n (append asci_m2 (list 32 70 71 72)))
 (setq asci_o (list (list 96 126) (list 58 127) (list 59 127) (list 34 128) (list 39 128) (list 44 129) (list 60 131) (list 62 132)))
 (setq asci_p (list 96 58 59 34 39 44 60 62))
 (setq asci_q (list 104 110 98 99 118 124 129 130 131))
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
(defun accord (not_ok_txt)
  (setq l (strlen not_ok_txt))
  (setq n 1)
  (setq nwo "")
  (while (<= n l)
   (if (= n 1)
    (setq ee " ")
    (setq ee (substr not_ok_txt (1- n) 1))
   )
   (setq f (substr not_ok_txt n 1))
   (if (= n l)
    (setq g " ")
    (setq g (substr not_ok_txt (1+ n) 1))
   )
   (setq asce  (ascii ee))
   (setq ascff (setq ascf (ascii f)))
   (setq ascg  (ascii g))
   (if (= (member ascf asci_m2) nil)
    (if (= (member ascf (list 32 95 70 71 72)) nil)
     (progn
      (if (/= (and (> ascf 64) (< ascf 94)) nil)
	(setq ascff (setq ascf (+ ascf 32)))
      )
      (if (/= (member ascf asci_p) nil)
	(setq ascf (car (cdr (assoc ascf asci_o))))
      )
      (if (/= (member asce asci_m) nil)
       (if (/= (member ascg asci_n) nil)
	(if (= (member ascf asci_q) nil)
	 (setq ascf (+ (* (- ascf 97) 3) 132))
	 (setq ascf ascff)
	)
	(setq ascf ascff)
       )
       (if (/= (member ascg asci_n) nil)
	(if (= (member ascf asci_q) nil)
	 (setq ascf (+ (* (- ascf 97) 3) 131))
	 (setq ascf (+ (* (- ascf 97) 3) 130))
	)
	(setq ascf (+ (* (- ascf 97) 3) 130))
       )
      )
     )
    )
   )
   (setq n (1+ n))
  (if (or (= ascf 176)(= ascf 177))
   (cond
      ((= ascf 176) (setq nwo (strcat nwo "%%176")) )
      ((= ascf 177) (setq nwo (strcat nwo "%%177")) )
    )
    (setq nwo (strcat nwo (chr ascf)))
  );end if
  )
  (setq not_ok_txt nwo)
)
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
(defun c:ft()
   (setvar "cmdecho" 0)
   (setvar "highlight" 0)
   (princ (strcat "Current TEXT style is " (getvar "TEXTSTYLE") " !!\n"))
   (setq st (list 1 4))
   (setq ss (ssadd))
   (command "_.point" "0,0")
   (setq entl (entlast))
   (ssadd entl ss)
   (setq rp "Style")
   (while (= rp "Style")
    (setq rp (getpoint "\nStart point:"))
   )
   (if (= (getvar "userr1") 0)(setvar "userr1" pi))
   (if (= rp nil)(setq st nil))
   (if (/= st nil)
    (progn
     (if (listp rp)
      (progn
       (setq st rp)
;----------- height and Rotation angle ------------------------------------
	 (setq f_heigth (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))
	 (if (= f_heigth 0.0)
	   (progn
	     (princ (strcat "\nHeight <" (rtos (getvar "textsize")) ">: "))
	     (setq ht (getdist st))
	     (if (/= ht nil)
	       (setvar "textsize" ht)
	       (setq ht "")
	     )
	   )
	 )
	 (princ (strcat "\nRotation angle <" (angtos (getvar "userr1")) ">: "))
	 (setq ro (getangle st))(if (/= ro nil)(setvar "userr1" ro))
;----------- End of height and Rotation angle part ------------------------------------
      )
     )
    )
   )
    (setq ro (+ (getvar "userr1") pi))
    (setq rl (getvar "aunits"))
    (cond ((= rl 0) (setq rog (angtos ro)))
	  ((= rl 1) (setq rog (angtos ro)))
	  ((= rl 2) (setq rog (atof (angtos ro))))
	  ((= rl 3) (setq rog (atof (angtos ro))))
	  ((= rl 4) (setq rog (rtd ro)))
    )
    (princ "\nText:")
    (if (= st nil)
     (command "_.dtext" "")
     (progn
      (if (listp rp)
	 (if (= f_heigth 0.0)
	     (command "_.dtext" st ht rog)
	     (command "_.dtext" st rog)
	 )
      )
    )
   )
;------------------- Main Loop ----------------------------------
(while (/= (entnext entl) nil)
    (setq txt (entnext entl))
    (setq e (entget txt))
    (setq s (cdr (setq as (assoc 1 e))))
    (setq s (accord s))
    (setq e (subst (cons 1 nwo) as e))
    (entmod e)
    (setq entl txt)
)
;-------------------End Loop-------------------------------------
   (command "_.erase" ss "")
   (setvar "highlight" 1)
   (setvar "cmdecho" 1)
   (setvar "blipmode" 1)
   (prin1)
;(alert "\n   Bana Borj Consultant ENG.  Reza Darvishi")
)
;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  (setq p1 "                  Reza pro Sep 2001       ")
(setq p2 "\n\n                Farsi texts for AutoCAD  ")
(setq p3 "\n\n  Bana Borj Consultant ENG.  Reza Darvishi ")
(setq p4 "\n\n  Type  ( nd ).............for select naskhd style ")
(setq p5 "\n\n  Type  ( nn ).............for select naskhn style ")
(setq p6 "\n\n  Type  ( ns ).............for select naskhs style  ")
(setq p7 "\n\n  Type  ( kf  ).............for select kofi  style ")
(setq p8 "\n\n  Type  ( tf  ).............for select trafic-d style ")
(setq p9 "\n\n  Type  ( ft  ).............for farsi texts ")
(setq p10 "\n\n                  +98(0611) 3778677,3363624")
(setq p (strcat p1 p2 p3 p4 p5 p6 p7 p8 p9 ))
(alert p)
(prin1)